home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagg_m.zip / MISC.SWG / 0006_HEBREW.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  15KB  |  573 lines
  1. {
  2. DAVID SOLLY
  3.  
  4. From Israel Moshe Harel was heard to say to David Solly
  5.  
  6. Thank you For taking the time to answer my many questions.  I have to
  7. tell you, though, that I was lucky to have received your letter because
  8. it was addressed to David SALLY and not David SOLLY.
  9.  
  10. >    Are you familiar With a Hebrew Text processor Program called QText?
  11. > I have been able to obtain version 2.10 as public domain software but I
  12. > am wondering if there has been an update.  Have you ever heard of a
  13.  
  14. MH>Current version of QText is 5.0 and it is commercial :-(
  15.   >It comes now With a full set of utilities, including FAX support.
  16.  
  17. Did you know that Q-Text version 2.10 was written in Turbo Pascal 3?  I
  18. wonder if Itschak Maynts (Isaac Mainz?) has continued to use it in his
  19. later versions.  Anyway, I would be interested in obtaining the latest
  20. version of Q-Text.  Can you give me the distributor's address and the
  21. approximate price?  Thank you.
  22.  
  23. >Most Israeli Printers have a special ROM. You may use downloadable Character
  24. >sets or even Graphic printing if needed. I once used LETTRIX For this purpos
  25. >on a Hebrew-less Printer, and it worked fine (but S L O W . . .).
  26.  
  27.  
  28. I have Letrix 3.6.  This was what I was trying to use to print the
  29. Q-Text Files I was writing.  I wrote a Program in Turbo Pascal to
  30. convert the Q-Text Files into Letrix Files.  The printing is slow but
  31. the results are favourable. Another advantage to Letrix Hebrew Files is
  32. that they are written completely in low-ASCII and almost readable
  33. without transliteration if one is at all familiar With Hebrew. It is a
  34. good format For posting Hebrew Text on the Multi-Lingual echo not only
  35. because it is low-ASCII but also because the method of transliteration
  36. is consistent.
  37.  
  38. Below is my Q-Text File to Letrix File conversion Program.  I hope you
  39. will find it useful.
  40. }
  41.  
  42. Program QTextLetrix;
  43.  
  44. {$D-}
  45.  
  46. Uses
  47.   Crt, Dos;
  48.  
  49.  
  50. Var
  51.   InFile,
  52.   TransFile   : Text;
  53.   InFilenm,
  54.   TransFilenm : PathStr;
  55.   Letter, Ans : Char;
  56.   Printable,
  57.   Hebrew,
  58.   Niqud,
  59.   Roman       : Set of Char;
  60.   Nkdm, Rom   : Boolean;
  61.  
  62. {
  63.    "UpItsCase" is a Function that takes a sting of any length and
  64.    sets all of the Characters in the String to upper case.  It is handy
  65.    For comparing Strings.
  66. }
  67.  
  68. Function UpItsCase (SourceStr : PathStr) : PathStr;
  69. Var
  70.   i  : Integer;
  71. begin
  72.   For i := 1 to length(SourceStr) do
  73.     SourceStr[i] := UpCase(SourceStr[i]);
  74.   UpItsCase := SourceStr
  75. end; {Function UpItsCase}
  76.  
  77.  
  78. Function Exist(fname : PathStr) : Boolean;
  79. Var
  80.   f : File;
  81. begin
  82. {$F-,I-}
  83.   Assign(f, fname);
  84.   Reset(f);
  85.   Close(f);
  86. {$I+}
  87.   Exist := (IOResult = 0) and (fname <> '')
  88. end; {Function exist}
  89.  
  90. Procedure Help;
  91. begin
  92.   Writeln;
  93.   Writeln ('QTLT (Version 1.0)');
  94.   Writeln ('Hebrew Text File Conversion');
  95.   Writeln ('Q-Text 2.10 File to Letrix(R) 3.6 Hebrew File');
  96.   Writeln;
  97.   Writeln;
  98.   Writeln ('QTLT converts Q-Text Files to Letrix Hebrew format Files.');
  99.   Writeln;
  100.   Writeln ('QTLT expects two parameters on the command line.');
  101.   Writeln ('The first parameter is the name of the File to convert,');
  102.   Writeln ('the second is the name of the new File.');
  103.   Writeln;
  104.   Writeln ('Example:  QTLT  HKVTL.HEB HKVTL.TXT');
  105.   Writeln;
  106.   Writeln ('If no parameters are found, QTLT will display this message.');
  107.   Writeln;
  108.   Halt;
  109. end; {Procedure Help}
  110.  
  111. {
  112.   "ParseCommandLine" is a Procedure that checks if any data was input
  113.   at the Dos command line.  If no data is there, then the "Help"
  114.   Procedure is executed and the Program is halted.  Otherwise, the
  115.   Mode strig Variable is set equal to the Text on the command line.
  116. }
  117.  
  118. Procedure ParseCommandLine;
  119. begin
  120.   if (ParamCount = 0) or (ParamCount <> 2) then
  121.     Help
  122.   else
  123.   begin
  124.     InFilenm    := ParamStr(1);
  125.     InFilenm    := UpItsCase(InFilenm);
  126.     TransFilenm := ParamStr(2);
  127.     TransFilenm := UpItsCase(TransFilenm);
  128.   end;
  129. end; {Procedure ParseCommandLine}
  130.  
  131. Procedure OpenFiles;
  132. begin
  133.   {Open input/output Files}
  134.   If not exist(InFilenm) then
  135.   begin
  136.     Writeln;
  137.     Writeln (InFilenm, ' not found');
  138.     Halt;
  139.   end
  140.   Else
  141.   begin
  142.     Assign (InFile, InFilenm);
  143.     Reset (InFile);
  144.   end;
  145.  
  146.   If exist (TransFilenm) then
  147.   begin
  148.     Writeln;
  149.     Writeln (TransFilenm, ' already exists!');
  150.     Write ('OverWrite it?  (Y/N) > ');
  151.     Repeat
  152.       Ans := ReadKey;
  153.       Ans := Upcase(Ans);
  154.       If Ans = 'N' then Halt;
  155.     Until Ans = 'Y';
  156.   end;
  157.  
  158.   Assign (TransFile, TransFilenm);
  159.   ReWrite (TransFile);
  160.   Writeln;
  161. end; {Procedure OpenFiles}
  162.  
  163.  
  164.  
  165. Procedure UseOfRoman;
  166. begin
  167.   Writeln ('QTLT has detected Roman letters in the source Text.');
  168.   Writeln;
  169.   Writeln ('Letrix expects access to a Roman font to print these Characters');
  170.   Writeln ('otherwise Letrix will report an error condition of fail to perform.');
  171.   Writeln;
  172.   Writeln ('Sample Letrix load instruction:  LX Hebrew Roman');
  173.   Writeln;
  174.   Writeln ('Be sure that these instances are enclosed within the proper');
  175.   Writeln ('Letrix font switch codes so they are not printed as Hebrew Character');
  176.   Writeln;
  177. end; {Procedure UseOfRoman}
  178.  
  179. Procedure Niqudim (Var Letter : Char);
  180. {
  181.    Letrix Uses some standard Characters to represent niqudim
  182.    While Q-Text does not.
  183.  
  184.    This table ensures that certain Characters do not become
  185.    niqudim when translated to Letrix by inserting the tokens
  186.    which instruct the Letrix Program to use the alternate
  187.    alphabet -- which by default is number 2.
  188. }
  189. begin
  190.   If Not Nkdm then
  191.   begin
  192.     Writeln;
  193.     Writeln ('QTLT has detected Q-Text Characters which Letrix normaly Uses for');
  194.     Writeln ('has transcribed them to print as normal Characters.');
  195.     Writeln;
  196.     Writeln ('Letrix expects access a Roman font to print these Characters');
  197.     Writeln ('otherwise Letrix will report an error condition of fail to perfect');
  198.     Writeln;
  199.     Writeln ('Sample Letrix load instruction:  LX Hebrew Roman');
  200.     Writeln;
  201.     Nkdm := True;
  202.   end; {if not Nkdm}
  203.  
  204.   Case Letter of
  205.  
  206.     '!' : Write (TransFile, '\2!\1');
  207.     '@' : Write (TransFile, '\2@\1');
  208.     '#' : Write (TransFile, '\2#\1');
  209.     '$' : Write (TransFile, '\2$\1');
  210.     '%' : Write (TransFile, '\2%\1');
  211.     '^' : Write (TransFile, '\2^\1');
  212.     '&' : Write (TransFile, '\2&\1');
  213.     '*' : Write (TransFile, '\2*\1');
  214.     '(' : Write (TransFile, '\2(\1');
  215.     ')' : Write (TransFile, '\2)\1');
  216.     '+' : Write (TransFile, '\2+\1');
  217.     '=' : Write (TransFile, '\2=\1');
  218.  
  219.   end; {Case}
  220.  
  221. end; {Procedure Nikudim}
  222.  
  223.  
  224.  
  225. Procedure QT_Table (Var Letter : Char);
  226. {
  227.   This section reviews each QText letter and matches it With a
  228.   Letrix equivalent where possible
  229. }
  230. begin
  231.   Case Letter of
  232.  
  233.     #128 : Write (TransFile, 'a');  {Alef}
  234.     #129 : Write (TransFile, 'b');  {Bet }
  235.     #130 : Write (TransFile, 'g');  {Gimmel etc. }
  236.     #131 : Write (TransFile, 'd');
  237.     #132 : Write (TransFile, 'h');
  238.     #133 : Write (TransFile, 'w');
  239.     #134 : Write (TransFile, 'z');
  240.     #135 : Write (TransFile, 'H');
  241.     #136 : Write (TransFile, 'T');
  242.     #137 : Write (TransFile, 'y');
  243.     #138 : Write (TransFile, 'C');
  244.     #139 : Write (TransFile, 'c');
  245.     #140 : Write (TransFile, 'l');
  246.     #141 : Write (TransFile, 'M');
  247.     #142 : Write (TransFile, 'm');
  248.     #143 : Write (TransFile, 'N');
  249.     #144 : Write (TransFile, 'n');
  250.     #145 : Write (TransFile, 'S');
  251.     #146 : Write (TransFile, 'i');
  252.     #147 : Write (TransFile, 'F');
  253.     #148 : Write (TransFile, 'p');
  254.     #149 : Write (TransFile, 'X');
  255.     #150 : Write (TransFile, 'x');
  256.     #151 : Write (TransFile, 'k');
  257.     #152 : Write (TransFile, 'r');
  258.     #153 : Write (TransFile, 's');
  259.     #154 : Write (TransFile, 't');
  260.  
  261.   end; {Case of}
  262.  
  263. end; {Procedure QT_Table}
  264.  
  265.  
  266. Procedure DoIt;
  267. {
  268.   Special commands requred by Letrix.
  269.   Proportional spacing off, line justification off,
  270.   double-strike on, pitch set to 12 Characters per inch.
  271. }
  272. begin
  273.  
  274.   Writeln(transFile,'\p\j\D\#12');
  275.   {Transcription loop}
  276.   While not eof(InFile) do
  277.   begin
  278.     Read(InFile, Letter);
  279.  
  280.     If (Letter in Printable) then
  281.       Write(TransFile, Letter);
  282.  
  283.     If (Letter in Niqud) then
  284.       Niqudim(Letter);
  285.  
  286.     If (Letter in Hebrew) then
  287.       QT_Table(Letter);
  288.  
  289.     If (Letter in Roman) and (Rom = False) then
  290.     begin
  291.       UseOfRoman;
  292.       Rom := True;
  293.     end; {Roman Detection}
  294.  
  295.   end; {while}
  296.  
  297.   {Close Files}
  298.  
  299.   Close (TransFile);
  300.   Close (InFile);
  301.  
  302.   {Final message}
  303.  
  304.   Writeln;
  305.   Writeln;
  306.   Writeln('QTLT (Version 1.0)');
  307.   Writeln('Hebrew Text File Conversion');
  308.   Writeln('Q-Text 2.10 Files to Letrix(R) 3.6 Hebrew File');
  309.   Writeln;
  310.   Writeln ('Task Complete');
  311.   Writeln;
  312.   Writeln ('QTLT was written and released to the public domain by David Solly');
  313.   Writeln ('Bibliotheca Sagittarii, Ottawa, Canada (2 December 1992).');
  314.   Writeln;
  315.  
  316. end; {Procedure DoIt}
  317.  
  318.  
  319. begin
  320.  
  321.   {Initialize Variables}
  322.   Printable := [#10,#12,#13,#32..#127];
  323.   Roman     := ['A'..'Z','a'..'z'];
  324.   Niqud     := ['!','@','#','$','%','^','&','*','(',')','+','='];
  325.   Printable := Printable - Niqud;
  326.   Hebrew    := [#128..#154];
  327.   Rom       := False;
  328.   Nkdm      := False;
  329.  
  330. ParseCommandLine;
  331. OpenFiles;
  332. DoIt;
  333.  
  334. end.
  335.  
  336. {
  337.  
  338.    Please find below the Turbo Pascal source code For the conversion
  339. Program For making Letrix Hebrew Files into Q-Text 2.10 Files.  I could
  340. not find a way to make this conversion Program convert embedded Roman
  341. Text without making it into a monster.  If you have any suggestions, I
  342. would be thankful to the input.
  343.  
  344. ========================= Cut Here ========================
  345. }
  346.  
  347. Program LetrixQText;
  348.  
  349. {$D-}
  350.  
  351. Uses
  352.   Crt, Dos;
  353.  
  354. Var
  355.   InFile,
  356.   TransFile   : Text;
  357.   InFilenm,
  358.   TransFilenm : PathStr;
  359.   Letter, Ans : Char;
  360.   Printable,
  361.   HiASCII     : Set of Char;
  362.  
  363. {
  364.   "UpItsCase" is a Function that takes a sting of any length and
  365.   sets all of the Characters in the String to upper case.  It is handy
  366.   For comparing Strings.
  367. }
  368.  
  369. Function UpItsCase (SourceStr : PathStr): PathStr;
  370. Var
  371.   i  : Integer;
  372. begin
  373.   For i := 1 to length(SourceStr) do
  374.     SourceStr[i] := UpCase(SourceStr[i]);
  375.   UpItsCase := SourceStr
  376. end; {Function UpItsCase}
  377.  
  378.  
  379. Function Exist(fname : PathStr) : Boolean;
  380. Var
  381.   f : File;
  382. begin
  383.   {$F-,I-}
  384.   Assign(f, fname);
  385.   Reset(f);
  386.   Close(f);
  387.   {$I+}
  388.   Exist := (IOResult = 0) and (fname <> '')
  389. end; {Function exist}
  390.  
  391. Procedure Help;
  392. begin
  393.   Writeln;
  394.   Writeln ('LTQT (Version 1.0)');
  395.   Writeln ('Hebrew Text File Conversion');
  396.   Writeln ('Letrix(R) 3.6 File to Q-Text 2.10 File');
  397.   Writeln;
  398.   Writeln;
  399.   Writeln ('LTQT converts Letrix Hebrew format Files to  Q-Text format Files.')
  400.   Writeln;
  401.   Writeln ('LTQT expects two parameters on the command line.');
  402.   Writeln ('The first parameter is the name of the File to convert,');
  403.   Writeln ('the second is the name of the new File.');
  404.   Writeln;
  405.   Writeln ('Example:  LTQT  HKVTL.TXT HKVTL.HEB');
  406.   Writeln;
  407.   Writeln ('If no parameters are found, LTQT will display this message.');
  408.   Writeln;
  409.   Halt;
  410. end; {Procedure Help}
  411.  
  412. {
  413.   "ParseCommandLine" is a Procedure that checks if any data was input
  414.   at the Dos command line.  If no data is there, then the "Help"
  415.   Procedure is executed and the Program is halted.  Otherwise, the
  416.   Mode strig Variable is set equal to the Text on the command line.
  417. }
  418. Procedure ParseCommandLine;
  419. begin
  420.   if (ParamCount = 0) or (ParamCount <> 2) then
  421.     Help
  422.   else
  423.   begin
  424.     InFilenm := ParamStr(1);
  425.     InFilenm := UpItsCase(InFilenm);
  426.     TransFilenm := ParamStr(2);
  427.     TransFilenm := UpItsCase(TransFilenm);
  428.   end;
  429. end; {Procedure ParseCommandLine}
  430.  
  431. Procedure OpenFiles;
  432. begin
  433.   {Open input/output Files}
  434.   If not exist(InFilenm) then
  435.   begin
  436.     Writeln;
  437.     Writeln (InFilenm, ' not found');
  438.     Halt;
  439.   end
  440.   Else
  441.   begin
  442.     Assign (InFile, InFilenm);
  443.     Reset (InFile);
  444.   end;
  445.  
  446.   If exist (TransFilenm) then
  447.   begin
  448.     Writeln;
  449.     Writeln (TransFilenm, ' already exists!');
  450.     Write ('OverWrite it?  (Y/N) > ');
  451.     Repeat
  452.       Ans := ReadKey;
  453.       Ans := Upcase(Ans);
  454.       If Ans = 'N' then Halt;
  455.     Until Ans = 'Y';
  456.   end;
  457.  
  458.   Assign (TransFile, TransFilenm);
  459.   ReWrite (TransFile);
  460.   Writeln;
  461.  
  462. end; {Procedure OpenFiles}
  463.  
  464.  
  465.  
  466. Procedure LT_Table (Var Letter : Char);
  467. {
  468.   This section reviews each Letrix letter and matches it With a
  469.   Q-Text equivalent where possible
  470. }
  471. begin
  472.   Case Letter of
  473.  
  474.     'a' : Write (TransFile, #128);
  475.     'b', 'B','v' : Write (TransFile, #129);  {Vet, Bet}
  476.     'g' : Write (TransFile, #130);
  477.     'd' : Write (TransFile, #131);
  478.     'h' : Write (TransFile, #132);
  479.     'V', 'o', 'u', 'w' : Write (TransFile, #133); {Vav, Holem male, Shuruq}
  480.     'z' : Write (TransFile, #134);
  481.     'H' : Write (TransFile, #135);
  482.     'T' : Write (TransFile, #136);
  483.     'y', 'e' : Write (TransFile, #137); {Yod}
  484.     'C', 'Q', 'W' : Write (TransFile, #138); {Khaf-Sofit}
  485.     'c', 'K' : Write (TransFile, #139); {Khaf, Kaf}
  486.     'l' : Write (TransFile, #140);
  487.     'M' : Write (TransFile, #141);
  488.     'm' : Write (TransFile, #142);
  489.     'N' : Write (TransFile, #143);
  490.     'n' : Write (TransFile, #144);
  491.     'S' : Write (TransFile, #145);
  492.     'i' : Write (TransFile, #146);
  493.     'F' : Write (TransFile, #147);
  494.     'p', 'P', 'f' : Write (TransFile, #148); {Fe, Pe}
  495.     'X' : Write (TransFile, #149);
  496.     'x' : Write (TransFile, #150);
  497.     'k' : Write (TransFile, #151);
  498.     'r' : Write (TransFile, #152);
  499.     's' : Write (TransFile, #153);
  500.     't' : Write (TransFile, #154);
  501.     'A' : Write (TransFile, '-');
  502.  
  503.     {Niqudim and unused letters}
  504.  
  505.     'D','E', 'G', 'I', 'J', 'j', 'O', 'q', 'R', 'U', 'Y', 'Z' :
  506.        Write(TransFile, '');
  507.   else
  508.     Write(TransFile, Letter);
  509.  
  510.   end; {Case of}
  511.  
  512. end; {Procedure LT_Table}
  513.  
  514.  
  515. Procedure DoIt;
  516. begin
  517.   {Transcription loop}
  518.   While not eof(InFile) do
  519.   begin
  520.     Read(InFile, Letter);
  521.  
  522.     If (Letter in Printable) then
  523.       LT_Table(Letter);
  524.  
  525.     If (Letter in HiASCII) then
  526.       Write(TransFile, Letter);
  527.   end; {while}
  528.  
  529.   {Close Files}
  530.  
  531.   Close (TransFile);
  532.   Close (InFile);
  533.  
  534.   {Final message}
  535.  
  536.   Writeln;
  537.   Writeln;
  538.   Writeln('LTQT Version 1.0');
  539.   Writeln('Hebrew Text File Conversion');
  540.   Writeln('Letrix(R) 3.6 File to Q-Text 2.10 File');
  541.   Writeln;
  542.   Writeln;
  543.   Writeln ('Letrix Hebrew File to Q-Text File conversion complete.');
  544.   Writeln;
  545.   Writeln('Special Note:');
  546.   Writeln;
  547.   Writeln ('Q-Text does not support either dagesh or niqudim (vowels).');
  548.   Writeln ('Letters containing a dagesh-qol are reduced to their simple form.');
  549.   Writeln ('Holam male and shuruq are transcribed as vav.  Roman letters used');
  550.   Writeln ('to represent niqudim are ignored.  All other symbols are transcribed'
  551.   Writeln ('without change.');
  552.   Writeln;
  553.   Writeln ('There is no foreign language check -- Anything that can be transcribe
  554.   Writeln ('into Hebrew Characters will be.');
  555.   Writeln;
  556.   Writeln ('LTQT was written and released to the public domain by David Solly');
  557.   Writeln ('Bibliotheca Sagittarii, Ottawa, Canada (8 December 1992).');
  558.   Writeln;
  559.  
  560. end; {Procedure DoIt}
  561.  
  562.  
  563. begin
  564.   {Initialize Variables}
  565.   Printable := [#10,#12,#13,#32..#127];
  566.   HiASCII   := [#128..#154];
  567.  
  568.   ParseCommandLine;
  569.   OpenFiles;
  570.   DoIt;
  571. end.
  572.  
  573.